VERSION 5.00
Begin VB.Form frmRepeat 
   Caption         =   "Form1"
   ClientHeight    =   3135
   ClientLeft      =   60
   ClientTop       =   405
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3135
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmRepeat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


' 2008-07-01, JFW, Must have Repeat.


Option Explicit
Option Compare Text

Dim WithEvents clsParserRepeat As clsFXRSParser  'FXRSParser class object
Attribute clsParserRepeat.VB_VarHelpID = -1

'---------------------------------------------------------------------------------------
' Procedure : ModifyButton()
' DateTime  : 2007-05-22
' Purpose   : If on the Ship tab, repeat the last shipment. If on
'             shipping list tab, repeat the selected shipment.
'---------------------------------------------------------------------------------------
'
Public Sub ModifyButton()
    On Error GoTo EH
    Dim i As Integer
    Dim vntBookMark As Variant
    Dim intNumBookMarks As Integer
    Dim intAnswer As Integer
    Dim strTrackingNumber As String
    Dim rsShipment As ADODB.Recordset
    
    g_strErrorLocation = "frmShip:ModifyButton"
    
    If frmShip.SSTab1.Tab = 3 Then
        With frmShip.History
            intNumBookMarks = frmShip.grdShipments.SelBookmarks.Count
            '07/12/06 Added And so nothing happens when showing Deleted pkgs
            If intNumBookMarks = 1 And frmShip.cboShipmentStatus <> "Deleted" Then
        
                If frmShip.grdShipments.Row >= 0 Then
                    strTrackingNumber = frmShip.grdShipments.Columns(0).Value
                End If
                
                If strTrackingNumber <> "" Then
                
                    Call frmShip.DeleteButton
                    
                    Set rsShipment = New ADODB.Recordset
                        
                    rsShipment.Source = "SELECT g_str29, [Transaction]"
                    rsShipment.Source = rsShipment.Source + " FROM Shipments WHERE g_str29 = '" & strTrackingNumber & "'"
                    rsShipment.Open , g_connFSMSClient
                    If rsShipment.BOF Then
                        rsShipment.Close
                        rsShipment.Source = Replace(rsShipment.Source, "Shipments", "TD")
                        rsShipment.Open , g_connFSMSClient
                    End If
                    If Not rsShipment.BOF Then
                        g_strRepeatTrans = rsShipment!Transaction & ""
                        If g_strRepeatTrans <> "" Then
                            If clsParserRepeat Is Nothing Then
                                Set clsParserRepeat = New clsFXRSParser
                            End If
                            clsParserRepeat.ParseData g_strRepeatTrans
                        Else
                            frmMsgBox.ShowMessage "Transaction data is not available for tracking number " & strTrackingNumber & ".", 4000
                        End If
                    Else
                        frmMsgBox.ShowMessage "Tracking number " & strTrackingNumber & " cannot be found in shipment history.", 4000
                    End If
                    rsShipment.Close
                    
                Else
                    frmMsgBox.ShowMessage "Tracking number cannot be determined.", 4000
                    
                End If
            
            Else
                frmMsgBox.ShowMessage "Modify function requires 1 selected record.  ", 4000
            
            End If
        End With
        
    Else
        frmMsgBox.ShowMessage "Modify function only from the History tab.  ", 4000
    
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : RepeatButton()
' DateTime  : 2007-05-22
' Purpose   : If on the Ship tab, repeat the last shipment. If on
'             shipping list tab, repeat the selected shipment.
'---------------------------------------------------------------------------------------
'
Public Sub RepeatButton()
    On Error GoTo EH
    Dim i As Integer
    Dim vntBookMark As Variant
    Dim intNumBookMarks As Integer
    Dim intAnswer As Integer
    Dim strTrackingNumber As String
    Dim rsShipment As ADODB.Recordset
    
    g_strErrorLocation = "frmShip:RepeatButton"
    
    If frmShip.SSTab1.Tab = 3 Then
        
'        intNumBookMarks = grdShipments.SelBookmarks.Count
'        If intNumBookMarks > 0 Then
'            For Each vntBookMark In grdShipments.SelBookmarks
'                dcShipments.Recordset.Bookmark = vntBookMark
'                With dcShipments.Recordset
'                    strTrackingNumber = .Fields(0)
'                End With
'                Exit For
'            Next
'        End If
    
        If frmShip.grdShipments.Row >= 0 Then
            strTrackingNumber = frmShip.grdShipments.Columns(0).Value
        End If
        
    End If
    
    'Repeat on Ship or Int'l tab
    If frmShip.SSTab1.Tab = 0 And g_str29 <> "" Then
        strTrackingNumber = g_str29
    End If
    
    If strTrackingNumber <> "" Then
    
        Set rsShipment = New ADODB.Recordset
            
        rsShipment.Source = "SELECT g_str29, [Transaction]" _
            & " FROM Shipments WHERE g_str29 = '" & strTrackingNumber & "'"
        rsShipment.Open , g_connFSMSClient
        If rsShipment.BOF Then
            rsShipment.Close
            rsShipment.Source = Replace(rsShipment.Source, " Shipments ", " TD ")
            rsShipment.Open , g_connFSMSClient
        End If
        If rsShipment.BOF Then
            rsShipment.Close
            rsShipment.Source = Replace(rsShipment.Source, " TD ", " IPD ")
            rsShipment.Open , g_connFSMSClient
        End If
        If Not rsShipment.BOF Then
            g_strRepeatTrans = rsShipment!Transaction & ""
            If g_strRepeatTrans <> "" Then
                If clsParserRepeat Is Nothing Then
                    Set clsParserRepeat = New clsFXRSParser
                End If
                clsParserRepeat.ParseData g_strRepeatTrans
            Else
                frmMsgBox.ShowMessage "Transaction data is not available for tracking number " & strTrackingNumber & ".", 4000
            End If
        Else
            frmMsgBox.ShowMessage "Tracking number " & strTrackingNumber & " cannot be found in shipment history.", 4000
        End If
        rsShipment.Close
        
    Else
        frmMsgBox.ShowMessage "Tracking number cannot be determined.", 4000
        
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub
'

Private Sub clsParserRepeat_ParseComplete()

    On Error GoTo EH
    
    Dim i As Integer ' Trans tag count
    Dim j As Integer ' Control array count
    Dim colCommodities As Collection
    Dim colCommodity As Collection
    Dim objControl As Control
    Dim strTag() As String
    Dim strError As String
    
    frmShip.f1 = Format(Now, "HHnnss")

    On Error Resume Next
    
    With clsParserRepeat
        For i = 0 To clsParserRepeat.TotalFields - 1
            If 0 <> InStr(.Field(i), "-") Then
                
                ' Instance field, save to collection
                strTag = Split(.Field(i), "-")
                Select Case strTag(0)
                    Case "77", "78", "79", "80", "81", "82", "83", "84", "120", "414", "1030", "1275", "119"
                        If UBound(strTag) > 1 Then
                            If IsNumeric(strTag(1)) And IsNumeric(strTag(2)) Then
                                strTag(1) = CStr(CLng(strTag(1)) * CLng(strTag(2)))
                            End If
                        End If
                        If colCommodities Is Nothing Then Set colCommodities = New Collection
                        Set colCommodity = Nothing
                        Set colCommodity = colCommodities.item(strTag(1))
                        If colCommodity Is Nothing Then
                            Set colCommodity = New Collection
                            colCommodities.Add colCommodity, strTag(1)
                        End If
                        If strTag(0) = "1030" Then
                            colCommodity.Add Val(.Data(i)) / 1000000, strTag(0)
                        ElseIf strTag(0) = "78" Then
                            colCommodity.Add Val(.Data(i)) / 100, strTag(0)
                        Else
                            colCommodity.Add .Data(i), strTag(0)
                        End If
                    
                    Case Else
                        strError = strError & IIf(strError <> "", ", ", "") & .Field(i) & " " & .Data(i)
                
                End Select
            
            Else
                Select Case .Field(i)
                    Case "0", "10", "117", "498"
                    Case "1"
                        g_blnLockOrderID = True
                        g_str1 = .Data(i) ' This will prevent refresh of IntlCommodities
                        'If frmShip.f1.Visible Then
                            frmShip.f1.Text = .Data(i)
                        'Else
                            frmShip.cboCustID.Text = .Data(i)
                        'End If
                    Case "4", "5", "6", "7", "8", "9", "32", "183", "1352"
                        ' Ignore shipper fields
                    Case "1485", "1486", "1487", "1488", "1489", "1490", "1491", "1492"
                    Case "24"
                        If CDate(Format(Right(.Data(i), 4), "00/00") & "/" & Left(.Data(i), 4)) >= Date Then
                            frmShip.Controls("f" & .Field(i)).Text = Format(Right(.Data(i), 4), "00/00") & "/" & Left(.Data(i), 4)
                        Else
                            frmShip.Controls("f" & .Field(i)).Text = Date
                        End If
                    Case "1670"
                        frmShip.Controls("f" & .Field(i)).Text = Val(.Data(i)) / 100
                    Case "118" ' EIN number
                        frmShip.f1358.Text = .Data(i)
                    Case "113", "119", "187", "537", "538", "544", "1282", "1370"
                        ' Ignore print and doc tab
                    Case "541", "542"
                        If g_strTDMasterTrkNbr <> "" Then
                            frmShip.f1482.Value = 1
                        End If
                        ' Ignore TD
                    Case "1116", "1119", "1333", "1349", "1529", "1585", "1586", "1651", "2975"
                        '
                        ' Ignore IPD
                    Case "1355"
                        '
                        ' Ignore 8 inch label
                    Case "2429", "2430", "2431", "2433", "2434", "2437", "2438"
                        '
                    Case "2805"
                        ' ETD
                        If .Data(i) = "Y" Then
                            frmShip.chkETD(0).Value = 1
                            frmShip.chkETD(1).Value = 1
                        Else
                            frmShip.chkETD(0).Value = 0
                            frmShip.chkETD(1).Value = 0
                        End If
                    Case "1688", "2103", "2818", "2820"
                        ' CI and ETD stuff
                    Case "2821"
                        ' FedEx or Custoemr CI
                        If .Data(i) = "F" Then
                            g_clsReg.SetRegistryValue "ETD_CI_Type", "F", REG_SZ
                        End If
                        If .Data(i) = "C" Then
                            g_clsReg.SetRegistryValue "ETD_CI_Type", "C", REG_SZ
                        End If
                    Case "3001", "3002"
                        ' Done using 3056, 3057
                    Case "6112", "6113"
                        ' EDT flags
                    Case "6114"
                        g_clsReg.SetRegistryValue "EDT_Letterhead", .Data(i), REG_SZ
                    Case "6115"
                        g_clsReg.SetRegistryValue "EDT_Signature", .Data(i), REG_SZ
                    Case Else
                        If .Field(i) = "11" Then
                            frmShip.cboCompany.Text = .Data(i)
                        ElseIf .Field(i) = "12" Then
                            frmShip.cboContact.Text = .Data(i)
                        End If
                        Select Case TypeName(frmShip.Controls("f" & .Field(i)))
                            Case "ComboBox", "TextBox"
                                frmShip.Controls("f" & .Field(i)).Text = .Data(i)
                            Case "CheckBox"
                                frmShip.Controls("f" & .Field(i)).Value = IIf(.Data(i) = "Y", 1, 0)
                            Case "Object"
                                For Each objControl In frmShip.Controls("f" & .Field(i))
                                    objControl.Text = .Data(i)
                                Next objControl
                            Case Else
                                strError = strError & IIf(strError <> "", ", ", "") & .Field(i) & " " & .Data(i)
                        End Select
                        If Err.number <> 0 Then
                            Err.Clear
                            strError = strError & IIf(strError <> "", ", ", "") & .Field(i) & " " & .Data(i)
                        End If
                        DoEvents

                End Select
            End If
        Next
    End With

    If Not colCommodities Is Nothing Then
        
        frmShip.txtCommodCount = 0
        frmShip.txtTotCustVal = 0
                
        Call DeleteIntlCommodities(frmShip.f1)
        
        For Each colCommodity In colCommodities
            With colCommodity
            
                Call InsertIntlCommodities(frmShip.f1, _
                    GetItem(colCommodity, "77"), _
                    GetItem(colCommodity, "79"), _
                    GetItem(colCommodity, "80"), _
                    GetItem(colCommodity, "81"), _
                    GetItem(colCommodity, "82"), _
                    GetItem(colCommodity, "83"), _
                    GetItem(colCommodity, "84"), _
                    GetItem(colCommodity, "414"), _
                    GetItem(colCommodity, "1030"), _
                    GetItem(colCommodity, "78"), _
                    GetItem(colCommodity, "1275"), _
                    GetItem(colCommodity, "120") _
                    )
                
                
                ' debugprint "Commodity", getitem(colCommodity, "82"), _
                '    getitem(colCommodity, "1030"), _
                '    getitem(colCommodity, "1275")
                
                frmShip.txtCommodCount = CLng(frmShip.txtCommodCount) + 1
                If IsNumeric(GetItem(colCommodity, "78")) Then
                    frmShip.txtTotCustVal = CDbl(frmShip.txtTotCustVal) + CDbl(GetItem(colCommodity, "78"))
                End If
                DoEvents
            
            End With
        Next colCommodity
        
        ' Call UpdateCommodityGrid(frmShip.f1)
        DoEvents
        
    End If

    DoEvents
    
    frmShip.SSTab1.Tab = 0
    frmShip.f25.SetFocus
    
    If strError <> "" Then
        frmMsgBox.ShowMessage "Some data is not recovered.  Please examine the shipment.  Includes:  " & strError, 20000
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "ParseRepeat"

End Sub
